home *** CD-ROM | disk | FTP | other *** search
/ Enter 2004 January / enter-2004-01.iso / files / maxima-5.9.0.exe / {app} / share / maxima / 5.9.0 / src / trgsmp.lisp < prev    next >
Encoding:
Text File  |  2003-02-09  |  21.4 KB  |  499 lines
  1. ;;; -*-  Mode: Lisp; Package: Maxima; Syntax: Common-Lisp; Base: 10 -*- ;;;;
  2. ;;;Translated on: 6/08/85 17:56:35;;Maxima System version 16
  3. ;;** Variable settings were **
  4.  
  5. (in-package "MAXIMA")
  6. ;;TRANSCOMPILE:FALSE;
  7. ;;TR_SEMICOMPILE:FALSE;
  8. ;;TRANSLATE_FAST_ARRAYS:TRUE;
  9. ;;TR_WARN_UNDECLARED:COMPILE;
  10. ;;TR_WARN_MEVAL:COMPFILE;
  11. ;;TR_WARN_FEXPR:COMPFILE;
  12. ;;TR_WARN_MODE:ALL;
  13. ;;TR_WARN_UNDEFINED_VARIABLE:ALL;
  14. ;;TR_FUNCTION_CALL_DEFAULT:GENERAL;
  15. ;;TR_ARRAY_AS_REF:TRUE;
  16. ;;TR_NUMER:FALSE;
  17. ;;DEFINE_VARIABLE:FALSE;
  18. NIL
  19. (eval-when (compile eval load)
  20.        (MEVAL* '(($MODEDECLARE) $BESTLENGTH $FIXNUM))
  21.        (MEVAL* '(($DECLARE) $BESTLENGTH $SPECIAL))
  22.        (DEFPROP $BESTLENGTH ASSIGN-MODE-CHECK ASSIGN)
  23.        (DEF-MTRVAR $BESTLENGTH 0))
  24. (eval-when (compile eval load)
  25.        (MEVAL* '(($MODEDECLARE) $TRYLENGTH $FIXNUM))
  26.        (MEVAL* '(($DECLARE) $TRYLENGTH $SPECIAL))
  27.        (DEFPROP $TRYLENGTH ASSIGN-MODE-CHECK ASSIGN)
  28.        (DEF-MTRVAR $TRYLENGTH 0))
  29. (eval-when (compile eval load)
  30. (proclaim '(special $ans ))
  31.  
  32. (SIMPLIFY ($PUT '%SIN '%COS '$COMPLEMENT_FUNCTION))
  33. (SIMPLIFY ($PUT '%COS '%SIN '$COMPLEMENT_FUNCTION))
  34. (SIMPLIFY ($PUT '%SINH '%COSH '$COMPLEMENT_FUNCTION))
  35. (SIMPLIFY ($PUT '%COSH '%SINH '$COMPLEMENT_FUNCTION))
  36. (SIMPLIFY ($PUT '%COS 1 '$UNITCOF))
  37. (SIMPLIFY ($PUT '%SIN 1 '$UNITCOF))
  38. (SIMPLIFY ($PUT '%COSH 1 '$UNITCOF))
  39. (SIMPLIFY ($PUT '%SINH -1 '$UNITCOF))
  40. (SIMPLIFY ($PUT '%COS -1 '$COMPLEMENT_COF))
  41. (SIMPLIFY ($PUT '%SIN -1 '$COMPLEMENT_COF))
  42. (SIMPLIFY ($PUT '%COSH 1 '$COMPLEMENT_COF))
  43. (SIMPLIFY ($PUT '%SINH 1 '$COMPLEMENT_COF))
  44. (SIMPLIFY ($PUT '%SIN '$TRIGONOMETRIC '$TYPE))
  45. (SIMPLIFY ($PUT '%COS '$TRIGONOMETRIC '$TYPE))
  46. (SIMPLIFY ($PUT '%SINH '$HYPER_TRIGONOMETRIC '$TYPE))
  47. (SIMPLIFY ($PUT '%COSH '$HYPER_TRIGONOMETRIC '$TYPE))
  48. )
  49. NIL
  50. (EVAL-WHEN (COMPILE LOAD EVAL) (MEVAL* '(($DECLARE) $LIST2 
  51.                                                               $SPECIAL)))
  52. (eval-when (compile eval load)
  53.        (DEFPROP $TRIGONOMETRICP T TRANSLATED)
  54.        (ADD2LNC '$TRIGONOMETRICP $PROPS)
  55.        (DEFMTRFUN ($TRIGONOMETRICP $BOOLEAN MDEFINE NIL NIL)
  56.                   ($EXP)
  57.                   NIL
  58.                   (OR (LIKE (SIMPLIFY ($GET (SIMPLIFY ($INPART $EXP 0))
  59.                                             '$TYPE))
  60.                             '$TRIGONOMETRIC)
  61.                       (LIKE (SIMPLIFY ($GET (TRD-MSYMEVAL $PIECE '$PIECE)
  62.                                             '$TYPE))
  63.                             '$HYPER_TRIGONOMETRIC))))
  64. (eval-when (compile eval load)
  65.        (DEFUN $TRIGRULE0
  66.               (|tr-gensym~0|)
  67.               (CATCH 'MATCH
  68.                       (PROG ($A |tr-gensym~1| |tr-gensym~2|)
  69.                             (DECLARE (SPECIAL $A |tr-gensym~1| |tr-gensym~2|))
  70.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~0|))
  71.                                                '%TAN))
  72.                                    (MATCHERR)))
  73.                             (SETQ |tr-gensym~1| (KDR |tr-gensym~0|))
  74.                             (SETQ |tr-gensym~2| (KAR |tr-gensym~1|))
  75.                             (SETQ $A |tr-gensym~2|)
  76.                             (COND ((NTHKDR |tr-gensym~1| 1)
  77.                                    (MATCHERR)))
  78.                             (RETURN (MUL* (POWER (SIMPLIFY (LIST '(%COS) $A))
  79.                                                  -1)
  80.                                           (SIMPLIFY (LIST '(%SIN) $A)))))))
  81.        (ADD2LNC '$TRIGRULE0 $RULES)
  82.        (MDEFPROP $TRIGRULE0
  83.                  ((MEQUAL) ((%TAN SIMP) $A)
  84.                            ((MTIMES SIMP) ((MEXPT SIMP) ((%COS SIMP) $A) -1)
  85.                                           ((%SIN SIMP) $A)))
  86.                  $RULE)
  87.        (MDEFPROP $TRIGRULE0 $DEFRULE $RULETYPE))
  88. (eval-when (compile eval load)
  89.        (DEFUN $TRIGRULE1
  90.               (|tr-gensym~3|)
  91.               (CATCH 'MATCH
  92.                       (PROG ($A |tr-gensym~4| |tr-gensym~5|)
  93.                             (DECLARE (SPECIAL $A |tr-gensym~4| |tr-gensym~5|))
  94.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~3|))
  95.                                                '%TAN))
  96.                                    (MATCHERR)))
  97.                             (SETQ |tr-gensym~4| (KDR |tr-gensym~3|))
  98.                             (SETQ |tr-gensym~5| (KAR |tr-gensym~4|))
  99.                             (SETQ $A |tr-gensym~5|)
  100.                             (COND ((NTHKDR |tr-gensym~4| 1)
  101.                                    (MATCHERR)))
  102.                             (RETURN (MUL* (POWER (SIMPLIFY (LIST '(%COS) $A))
  103.                                                  -1)
  104.                                           (SIMPLIFY (LIST '(%SIN) $A)))))))
  105.        (ADD2LNC '$TRIGRULE1 $RULES)
  106.        (MDEFPROP $TRIGRULE1
  107.                  ((MEQUAL) ((%TAN SIMP) $A)
  108.                            ((MTIMES SIMP) ((MEXPT SIMP) ((%COS SIMP) $A) -1)
  109.                                           ((%SIN SIMP) $A)))
  110.                  $RULE)
  111.        (MDEFPROP $TRIGRULE1 $DEFRULE $RULETYPE))
  112. (eval-when (compile eval load)
  113.        (DEFUN $TRIGRULE2
  114.               (|tr-gensym~6|)
  115.               (CATCH 'MATCH
  116.                       (PROG ($A |tr-gensym~7| |tr-gensym~8|)
  117.                             (DECLARE (SPECIAL $A |tr-gensym~7| |tr-gensym~8|))
  118.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~6|))
  119.                                                '%SEC))
  120.                                    (MATCHERR)))
  121.                             (SETQ |tr-gensym~7| (KDR |tr-gensym~6|))
  122.                             (SETQ |tr-gensym~8| (KAR |tr-gensym~7|))
  123.                             (SETQ $A |tr-gensym~8|)
  124.                             (COND ((NTHKDR |tr-gensym~7| 1)
  125.                                    (MATCHERR)))
  126.                             (RETURN (POWER (SIMPLIFY (LIST '(%COS) $A)) -1)))))
  127.        (ADD2LNC '$TRIGRULE2 $RULES)
  128.        (MDEFPROP $TRIGRULE2
  129.                  ((MEQUAL) ((%SEC SIMP) $A) ((MEXPT SIMP) ((%COS SIMP) $A) -1))
  130.                  $RULE)
  131.        (MDEFPROP $TRIGRULE2 $DEFRULE $RULETYPE))
  132. (eval-when (compile eval load)
  133.        (DEFUN $TRIGRULE3
  134.               (|tr-gensym~9|)
  135.               (CATCH 'MATCH
  136.                       (PROG ($A |tr-gensym~10| |tr-gensym~11|)
  137.                             (DECLARE (SPECIAL $A
  138.                                               |tr-gensym~10|
  139.                                               |tr-gensym~11|))
  140.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~9|))
  141.                                                '%CSC))
  142.                                    (MATCHERR)))
  143.                             (SETQ |tr-gensym~10| (KDR |tr-gensym~9|))
  144.                             (SETQ |tr-gensym~11| (KAR |tr-gensym~10|))
  145.                             (SETQ $A |tr-gensym~11|)
  146.                             (COND ((NTHKDR |tr-gensym~10| 1)
  147.                                    (MATCHERR)))
  148.                             (RETURN (POWER (SIMPLIFY (LIST '(%SIN) $A)) -1)))))
  149.        (ADD2LNC '$TRIGRULE3 $RULES)
  150.        (MDEFPROP $TRIGRULE3
  151.                  ((MEQUAL) ((%CSC SIMP) $A) ((MEXPT SIMP) ((%SIN SIMP) $A) -1))
  152.                  $RULE)
  153.        (MDEFPROP $TRIGRULE3 $DEFRULE $RULETYPE))
  154. (eval-when (compile eval load)
  155.        (DEFUN $TRIGRULE4
  156.               (|tr-gensym~12|)
  157.               (CATCH 'MATCH
  158.                       (PROG ($A |tr-gensym~13| |tr-gensym~14|)
  159.                             (DECLARE (SPECIAL $A
  160.                                               |tr-gensym~13|
  161.                                               |tr-gensym~14|))
  162.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~12|))
  163.                                                '%COT))
  164.                                    (MATCHERR)))
  165.                             (SETQ |tr-gensym~13| (KDR |tr-gensym~12|))
  166.                             (SETQ |tr-gensym~14| (KAR |tr-gensym~13|))
  167.                             (SETQ $A |tr-gensym~14|)
  168.                             (COND ((NTHKDR |tr-gensym~13| 1)
  169.                                    (MATCHERR)))
  170.                             (RETURN (MUL* (SIMPLIFY (LIST '(%COS) $A))
  171.                                           (POWER (SIMPLIFY (LIST '(%SIN)
  172.                                                                  $A))
  173.                                                  -1))))))
  174.        (ADD2LNC '$TRIGRULE4 $RULES)
  175.        (MDEFPROP $TRIGRULE4
  176.                  ((MEQUAL) ((%COT SIMP) $A)
  177.                            ((MTIMES SIMP) ((%COS SIMP) $A)
  178.                                           ((MEXPT SIMP) ((%SIN SIMP) $A) -1)))
  179.                  $RULE)
  180.        (MDEFPROP $TRIGRULE4 $DEFRULE $RULETYPE))
  181. (eval-when (compile eval load)
  182.        (DEFUN $HTRIGRULE1
  183.               (|tr-gensym~15|)
  184.               (CATCH 'MATCH
  185.                       (PROG ($A |tr-gensym~16| |tr-gensym~17|)
  186.                             (DECLARE (SPECIAL $A
  187.                                               |tr-gensym~16|
  188.                                               |tr-gensym~17|))
  189.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~15|))
  190.                                                '%TANH))
  191.                                    (MATCHERR)))
  192.                             (SETQ |tr-gensym~16| (KDR |tr-gensym~15|))
  193.                             (SETQ |tr-gensym~17| (KAR |tr-gensym~16|))
  194.                             (SETQ $A |tr-gensym~17|)
  195.                             (COND ((NTHKDR |tr-gensym~16| 1)
  196.                                    (MATCHERR)))
  197.                             (RETURN (MUL* (POWER (SIMPLIFY (LIST '(%COSH)
  198.                                                                  $A))
  199.                                                  -1)
  200.                                           (SIMPLIFY (LIST '(%SINH) $A)))))))
  201.        (ADD2LNC '$HTRIGRULE1 $RULES)
  202.        (MDEFPROP $HTRIGRULE1
  203.                  ((MEQUAL) ((%TANH SIMP) $A)
  204.                            ((MTIMES SIMP) ((MEXPT SIMP) ((%COSH SIMP) $A) -1)
  205.                                           ((%SINH SIMP) $A)))
  206.                  $RULE)
  207.        (MDEFPROP $HTRIGRULE1 $DEFRULE $RULETYPE))
  208. (eval-when (compile eval load)
  209.        (DEFUN $HTRIGRULE2
  210.               (|tr-gensym~18|)
  211.               (CATCH 'MATCH
  212.                       (PROG ($A |tr-gensym~19| |tr-gensym~20|)
  213.                             (DECLARE (SPECIAL $A
  214.                                               |tr-gensym~19|
  215.                                               |tr-gensym~20|))
  216.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~18|))
  217.                                                '%SECH))
  218.                                    (MATCHERR)))
  219.                             (SETQ |tr-gensym~19| (KDR |tr-gensym~18|))
  220.                             (SETQ |tr-gensym~20| (KAR |tr-gensym~19|))
  221.                             (SETQ $A |tr-gensym~20|)
  222.                             (COND ((NTHKDR |tr-gensym~19| 1)
  223.                                    (MATCHERR)))
  224.                             (RETURN (POWER (SIMPLIFY (LIST '(%COSH) $A)) -1)))))
  225.        (ADD2LNC '$HTRIGRULE2 $RULES)
  226.        (MDEFPROP $HTRIGRULE2
  227.                  ((MEQUAL) ((%SECH SIMP) $A)
  228.                            ((MEXPT SIMP) ((%COSH SIMP) $A) -1))
  229.                  $RULE)
  230.        (MDEFPROP $HTRIGRULE2 $DEFRULE $RULETYPE))
  231. (eval-when (compile eval load)
  232.        (DEFUN $HTRIGRULE3
  233.               (|tr-gensym~21|)
  234.               (CATCH 'MATCH
  235.                       (PROG ($A |tr-gensym~22| |tr-gensym~23|)
  236.                             (DECLARE (SPECIAL $A
  237.                                               |tr-gensym~22|
  238.                                               |tr-gensym~23|))
  239.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~21|))
  240.                                                '%CSCH))
  241.                                    (MATCHERR)))
  242.                             (SETQ |tr-gensym~22| (KDR |tr-gensym~21|))
  243.                             (SETQ |tr-gensym~23| (KAR |tr-gensym~22|))
  244.                             (SETQ $A |tr-gensym~23|)
  245.                             (COND ((NTHKDR |tr-gensym~22| 1)
  246.                                    (MATCHERR)))
  247.                             (RETURN (POWER (SIMPLIFY (LIST '(%SINH) $A)) -1)))))
  248.        (ADD2LNC '$HTRIGRULE3 $RULES)
  249.        (MDEFPROP $HTRIGRULE3
  250.                  ((MEQUAL) ((%CSCH SIMP) $A)
  251.                            ((MEXPT SIMP) ((%SINH SIMP) $A) -1))
  252.                  $RULE)
  253.        (MDEFPROP $HTRIGRULE3 $DEFRULE $RULETYPE))
  254. (eval-when (compile eval load)
  255.        (DEFUN $HTRIGRULE4
  256.               (|tr-gensym~24|)
  257.               (CATCH 'MATCH
  258.                       (PROG ($A |tr-gensym~25| |tr-gensym~26|)
  259.                             (DECLARE (SPECIAL $A
  260.                                               |tr-gensym~25|
  261.                                               |tr-gensym~26|))
  262.                             (COND ((NOT (EQUAL (KAR (KAR |tr-gensym~24|))
  263.                                                '%COTH))
  264.                                    (MATCHERR)))
  265.                             (SETQ |tr-gensym~25| (KDR |tr-gensym~24|))
  266.                             (SETQ |tr-gensym~26| (KAR |tr-gensym~25|))
  267.                             (SETQ $A |tr-gensym~26|)
  268.                             (COND ((NTHKDR |tr-gensym~25| 1)
  269.                                    (MATCHERR)))
  270.                             (RETURN (MUL* (SIMPLIFY (LIST '(%COSH) $A))
  271.                                           (POWER (SIMPLIFY (LIST '(%SINH)
  272.                                                                  $A))
  273.                                                  -1))))))
  274.        (ADD2LNC '$HTRIGRULE4 $RULES)
  275.        (MDEFPROP $HTRIGRULE4
  276.                  ((MEQUAL) ((%COTH SIMP) $A)
  277.                            ((MTIMES SIMP) ((%COSH SIMP) $A)
  278.                                           ((MEXPT SIMP) ((%SINH SIMP) $A) -1)))
  279.                  $RULE)
  280.        (MDEFPROP $HTRIGRULE4 $DEFRULE $RULETYPE))
  281. (eval-when (compile eval load)
  282.  (DEFPROP $TRIGSIMP T TRANSLATED)
  283.  (ADD2LNC '$TRIGSIMP $PROPS)
  284.  (DEFMTRFUN
  285.   ($TRIGSIMP $ANY MDEFINE NIL NIL)
  286.   ($X)
  287.   NIL
  288.   (SIMPLIFY
  289.    ($TRIGSIMP3
  290.     (SIMPLIFY ($RADCAN (DO ((|tr-gensym~27| $X
  291.                                             (APPLY1 |tr-gensym~27|
  292.                                                     (CAR |tr-gensym~28|)
  293.                                                     0))
  294.                             (|tr-gensym~28| '($TRIGRULE1 $TRIGRULE2 
  295.                                               $TRIGRULE3 $TRIGRULE4 
  296.                                               $HTRIGRULE1 $HTRIGRULE2 
  297.                                               $HTRIGRULE3 $HTRIGRULE4)
  298.                                             (CDR |tr-gensym~28|)))
  299.                            ((NULL |tr-gensym~28|) |tr-gensym~27|)
  300.                         )))))))
  301. (eval-when (compile eval load)
  302.  (DEFPROP $TRIGSIMP3 T TRANSLATED)
  303.  (ADD2LNC '$TRIGSIMP3 $PROPS)
  304.  (DEFMTRFUN
  305.   ($TRIGSIMP3 $ANY MDEFINE NIL NIL)
  306.   ($EXPN)
  307.   NIL
  308.   (PROGN (SETQ $EXPN (SIMPLIFY ($TOTALDISREP $EXPN)))
  309.          (SIMPLIFY ($RATSIMP (DIV (SIMPLIFY ($TRIGSIMP1 ($NUM $EXPN)))
  310.                                   (SIMPLIFY ($TRIGSIMP1 ($DENOM $EXPN)))))))))
  311. (eval-when (compile eval load)
  312.        (DEFPROP $TRIGSIMP1 T TRANSLATED)
  313.        (ADD2LNC '$TRIGSIMP1 $PROPS)
  314.        (DEFMTRFUN ($TRIGSIMP1 $ANY MDEFINE NIL NIL)
  315.                   ($EXPN)
  316.                   NIL
  317.                   ((LAMBDA ($LISTOFTRIGSQ $BESTLENGTH $TRYLENGTH)
  318.                        NIL
  319.                        (ASSIGN-MODE-CHECK '$TRYLENGTH $TRYLENGTH)
  320.                        (ASSIGN-MODE-CHECK '$BESTLENGTH $BESTLENGTH)
  321.                        (SETQ $LISTOFTRIGSQ (SIMPLIFY ($LISTOFTRIGSQ $EXPN)))
  322.                        (PROGN (ASSIGN-MODE-CHECK '$BESTLENGTH 999999)
  323.                               (SETQ $BESTLENGTH 999999))
  324.                        (COND ((NOT (LIKE $LISTOFTRIGSQ '((MLIST))))
  325.                               (SIMPLIFY ($IMPROVE $EXPN
  326.                                                   $EXPN
  327.                                                   $LISTOFTRIGSQ)))
  328.                              (T $EXPN)))
  329.                    '$LISTOFTRIGSQ
  330.                    0
  331.                    0)))
  332. (eval-when (compile eval load)
  333.  (DEFPROP $IMPROVE T TRANSLATED)
  334.  (ADD2LNC '$IMPROVE $PROPS)
  335.  (DEFMTRFUN
  336.   ($IMPROVE $ANY MDEFINE NIL NIL)
  337.   ($EXPN $SUBSOFAR $LISTOFTRIGSQ)
  338.   NIL
  339.   (COND
  340.    ((LIKE $LISTOFTRIGSQ '((MLIST)))
  341.     (COND ((< ((LAMBDA (|tr-gensym~31|)
  342.                    (PROGN (ASSIGN-MODE-CHECK '$TRYLENGTH |tr-gensym~31|)
  343.                           (SETQ $TRYLENGTH |tr-gensym~31|)))
  344.                ($EXPNLENGTH $SUBSOFAR))
  345.               (TRD-MSYMEVAL $BESTLENGTH 0))
  346.            ((LAMBDA (|tr-gensym~30|)
  347.                 (PROGN (ASSIGN-MODE-CHECK '$BESTLENGTH |tr-gensym~30|)
  348.                        (SETQ $BESTLENGTH |tr-gensym~30|)))
  349.             (TRD-MSYMEVAL $TRYLENGTH 0))
  350.            $SUBSOFAR)
  351.           (T $EXPN)))
  352.    (T
  353.     (SETQ $SUBSOFAR (SIMPLIFY ($IMPROVE $EXPN
  354.                                         $SUBSOFAR
  355.                                         (SIMPLIFY ($REST $LISTOFTRIGSQ)))))
  356.     (DO
  357.      (($ALT) (MDO (CDR (SIMPLIFY ($FIRST $LISTOFTRIGSQ))) (CDR MDO)))
  358.      ((NULL MDO) '$DONE)
  359.      (SETQ $ALT (CAR MDO))
  360.      (SETQ
  361.       $SUBSOFAR
  362.       (SIMPLIFY
  363.        ($IMPROVE
  364.         $SUBSOFAR
  365.         (SIMPLIFY
  366.          ($RATSUBST
  367.           (ADD*
  368.            (SIMPLIFY ($GET (SIMPLIFY ($INPART $ALT 0)) '$UNITCOF))
  369.            (MUL*
  370.             (SIMPLIFY ($GET (TRD-MSYMEVAL $PIECE '$PIECE)
  371.                             '$COMPLEMENT_COF))
  372.             (POWER
  373.              (SIMPLIFY (MAPPLY (SIMPLIFY ($GET (TRD-MSYMEVAL $PIECE
  374.                                                              '$PIECE)
  375.                                                '$COMPLEMENT_FUNCTION))
  376.                                (LIST (SIMPLIFY ($FIRST $ALT)))
  377.                                '(($GET) $PIECE 
  378.                                  ((MQUOTE) $COMPLEMENT_FUNCTION))))
  379.              2)))
  380.           (POWER $ALT 2)
  381.           $SUBSOFAR))
  382.         (SIMPLIFY ($REST $LISTOFTRIGSQ))))))
  383.     $SUBSOFAR))))
  384. (eval-when (compile eval load)
  385.  (DEFPROP $LISTOFTRIGSQ T TRANSLATED)
  386.  (ADD2LNC '$LISTOFTRIGSQ $PROPS)
  387.  (DEFMTRFUN
  388.   ($LISTOFTRIGSQ $ANY MDEFINE NIL NIL)
  389.   ($EXPN)
  390.   NIL
  391.   (COND
  392.    (($ATOM $EXPN) '((MLIST)))
  393.    (T
  394.     ((LAMBDA
  395.       ($INFLAG $ANS) 
  396.       NIL
  397.       (PROG
  398.        NIL
  399.        (COND ((AND (LIKE (SIMPLIFY ($INPART $EXPN 0)) '&^)
  400.                    ($INTEGERP (SIMPLIFY ($INPART $EXPN 2)))
  401.                    (NOT (IS-BOOLE-CHECK (MLSP (TRD-MSYMEVAL $PIECE
  402.                                                             '$PIECE)
  403.                                               2))))
  404.               (COND (($ATOM (SETQ $EXPN (SIMPLIFY ($INPART $EXPN 1))))
  405.                      (RETURN '((MLIST))))
  406.                     (($TRIGONOMETRICP $EXPN)
  407.                      (RETURN (LIST '(MLIST) (LIST '(MLIST) $EXPN)))))))
  408.        (SETQ $INFLAG T)
  409.        (DO
  410.         (($ARG) (MDO (CDR $EXPN) (CDR MDO)))
  411.         ((NULL MDO) '$DONE)
  412.         (SETQ $ARG (CAR MDO))
  413.         (SETQ
  414.          $ANS
  415.          (SIMPLIFY ($SPECIALUNION (SIMPLIFY ($LISTOFTRIGSQ $ARG))
  416.                                   (TRD-MSYMEVAL $ANS '$ANS)))))
  417.        (RETURN (TRD-MSYMEVAL $ANS '$ANS))))
  418.      '$INFLAG
  419.      '((MLIST)))))))
  420. (eval-when (compile eval load)
  421.  (DEFPROP $SPECIALUNION T TRANSLATED)
  422.  (ADD2LNC '$SPECIALUNION $PROPS)
  423.  (DEFMTRFUN
  424.   ($SPECIALUNION $ANY MDEFINE NIL NIL)
  425.   ($LIST1 $LIST2)
  426.   NIL
  427.   (COND
  428.    ((LIKE $LIST1 '((MLIST))) (TRD-MSYMEVAL $LIST2 '$LIST2))
  429.    ((LIKE (TRD-MSYMEVAL $LIST2 '$LIST2) '((MLIST))) $LIST1)
  430.    (T
  431.     ((LAMBDA
  432.       ($ALTERNATES)
  433.       NIL
  434.       (DO
  435.        (($ALT) (MDO (CDR $ALTERNATES) (CDR MDO)))
  436.        ((NULL MDO) '$DONE)
  437.        (SETQ $ALT (CAR MDO))
  438.        (SETQ
  439.         $LIST2
  440.         (SIMPLIFY ($UPDATE $ALT
  441.                            (SIMPLIFY ($GET (SIMPLIFY ($INPART $ALT 0))
  442.                                            '$COMPLEMENT_FUNCTION))))))
  443.       (SIMPLIFY ($SPECIALUNION (SIMPLIFY ($REST $LIST1))
  444.                                (TRD-MSYMEVAL $LIST2 '$LIST2))))
  445.      (SIMPLIFY ($FIRST $LIST1)))))))
  446. (eval-when (compile eval load) 
  447.  (DEFPROP $UPDATE T TRANSLATED)
  448.  (ADD2LNC '$UPDATE $PROPS)
  449.  (DEFMTRFUN
  450.   ($UPDATE $ANY MDEFINE NIL NIL)
  451.   ($FORM $COMPLEMENT)
  452.   NIL
  453.   ((LAMBDA
  454.     ($ANS)
  455.      (declare (special $ans))
  456.     NIL
  457.     NIL
  458.     (SETQ $COMPLEMENT (SIMPLIFY (MFUNCALL $COMPLEMENT
  459.                                           (SIMPLIFY ($INPART $FORM 1)))))
  460.     (SETQ
  461.      $ANS
  462.      (DO (($ELEMENT)
  463.           (MDO (CDR (TRD-MSYMEVAL $LIST2 '$LIST2)) (CDR MDO)))
  464.          ((NULL MDO) '$DONE)
  465.        (SETQ $ELEMENT (CAR MDO))
  466.        (COND (($MEMBER $FORM $ELEMENT)
  467.               (RETURN '$FOUND))
  468.              (($MEMBER $COMPLEMENT $ELEMENT)
  469.               (RETURN ($CONS (LIST '(MLIST) $FORM $COMPLEMENT)
  470.                              (SIMPLIFY ($DELETE $ELEMENT
  471.                                                 (TRD-MSYMEVAL $LIST2
  472.                                                               '$LIST2)))))))))
  473.     (COND ((LIKE (TRD-MSYMEVAL $ANS '$ANS) '$FOUND)
  474.            (TRD-MSYMEVAL $LIST2 '$LIST2))
  475.           ((LIKE (TRD-MSYMEVAL $ANS '$ANS) '$DONE)
  476.            ($CONS (LIST '(MLIST) $FORM) (TRD-MSYMEVAL $LIST2 '$LIST2)))
  477.           (T (TRD-MSYMEVAL $ANS '$ANS))))
  478.    '$ANS)))
  479. (eval-when (compile eval load) 
  480.        (DEFPROP $EXPNLENGTH T TRANSLATED)
  481.        (ADD2LNC '$EXPNLENGTH $PROPS)
  482.        (DEFMTRFUN ($EXPNLENGTH $FIXNUM MDEFINE NIL NIL)
  483.                   ($EXPR)
  484.                   NIL
  485.                   ((LAMBDA ($INFLAG)
  486.                        NIL
  487.                        (COND (($ATOM $EXPR) 1)
  488.                              (T (f+ 1
  489.                                    ($ARGSLENGTH (SIMPLIFY ($ARGS $EXPR)))))))
  490.                    T)))
  491. (eval-when (compile eval load) 
  492.  (DEFPROP $ARGSLENGTH T TRANSLATED)
  493.  (ADD2LNC '$ARGSLENGTH $PROPS)
  494.  (DEFMTRFUN ($ARGSLENGTH $ANY MDEFINE NIL NIL)
  495.             ($ARGS)
  496.             NIL
  497.             (SIMPLIFY (MAPPLY-TR '&+
  498.                                  (SIMPLIFY (MAP1 (GETOPR '$EXPNLENGTH)
  499.                                                  $ARGS))))))